home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol033 / aalc.bas next >
Encoding:
BASIC Source File  |  1987-01-11  |  2.1 KB  |  86 lines
  1. 5  CLOSE #2: OPEN "lpt1:" FOR OUTPUT AS #2
  2. 10 CLS:PRINT#2,"Program ALC.BAS - average linkage clustering"
  3. 20 '  a heirachical classification for N individuals.
  4. 30 '  input data - the upper half of an N*N similarity matrix
  5. 40 '  that is R-squares.  Excludes the diagonal. Starts row 1, col.2-n
  6. 45 '  VERSION 3/83 - compiled for HARD DISK   D. Wang cybersoft group
  7. 50 '
  8. 60 PRINT#2,"====================================================":PRINT#2,
  9. 65 '
  10. 70 INPUT"Enter input matrix name (try C:corrmat.dat)";INA$
  11. 80 OPEN INA$ FOR INPUT AS #1
  12. 90 INPUT"Enter N, number of sets to cluster (max. 40)";N
  13. 100 DIM S(40,40), R(40,40), N(40)
  14. 110 '   array symbols: S,R - NxN arrays
  15. 120 '                  N - vector with N values
  16. 130 '
  17. 140 '  read in data
  18. 150 '
  19. 220 FOR L=1 TO N-1
  20. 230   FOR M=L+1 TO N
  21. 240    INPUT#1,A
  22. 250    S(L,M)=A
  23. 260    S(M,L)=A
  24. 270  NEXT M
  25. 280 NEXT L
  26. 290 FOR I=1 TO N:FOR J=1 TO N:R(I,J)=0:NEXT:N(I)=1:NEXT 'initialize matrices
  27. 300 FOR L=1 TO N
  28. 310   R(L,1)=L
  29. 320 NEXT L
  30. 330 '   find valid fusions
  31. 340 Q=0
  32. 350 FOR I=1 TO N-1
  33. 360   FOR J=I+1 TO N
  34. 370     IF S(I,J)<=Q THEN 410
  35. 380     Q=S(I,J)
  36. 390     L=I
  37. 400     M=J
  38. 410   NEXT J
  39. 415 NEXT I
  40. 420 IF Q=0 THEN 870
  41. 430 C=0
  42. 440 '   update group registers
  43. 450 FOR I=N(L)+1 TO N(L)+N(M)
  44. 460   C=C+1
  45. 470   R(L,I)=R(M,C)
  46. 480   R(M,C)=0
  47. 490 NEXT I
  48. 500 N1=N(L)
  49. 510 N2=N(M)
  50. 520 N3=N1+N2
  51. 540 N(L)=N(L)+N(M)
  52. 560 N(M)=0
  53. 570 '   print fusion statistics
  54. 600 C6=C6+1
  55. 610 PRINT#2,
  56. 620 PRINT#2,"   clustering pass ";C6;"      number of individuals =";N(L)
  57. 640 PRINT#2,"   average similarity";Q
  58. 650 PRINT#2,"   individuals: "
  59. 660 FOR J=1 TO N
  60. 670   IF R(L,J)=0 THEN 700
  61. 680   PRINT#2," ";R(L,J);
  62. 690 NEXT J
  63. 700 PRINT#2,
  64. 720 '   compute average similarities
  65. 730 FOR J=1 TO N
  66. 740   IF S(L,J)=-1000 THEN 810
  67. 750   IF M=J THEN 810
  68. 755   IF J=L THEN 810
  69. 760   A=(N1/N3)*S(L,J)
  70. 770   B=(N2/N3)*S(M,J)
  71. 780   D=((N1*N2)/(N3*N3))*(1-S(L,M))
  72. 790   S(L,J)=A+B+D
  73. 800   S(J,L)=A+B+D
  74. 810 NEXT J
  75. 820 FOR J=1 TO N
  76. 830   S(M,J)=-1000
  77. 840   S(J,M)=-1000
  78. 850 NEXT J
  79. 860 GOTO 330
  80. 870 END
  81. 
  82. 800   S(J,L)=A+B+D
  83. 810 NEXT J
  84. 820 FOR J=1 TO N
  85. 830   S(M,J)=-1000
  86. 840   S(J,M)=-1000
  87.